home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 8 / Amoszine 8 (Disk 3 of 3).adf / Mike_Richmond.lha / mike2 / pd-fuguewriter / Fugue_writer.asc < prev    next >
Encoding:
Text File  |  1999-09-02  |  11.6 KB  |  424 lines
  1. WBStartup
  2. ;This programme was the subject of a brief demonstration at the North Shore
  3. ;meeting on 27/7/94. I was tempted to explore algorithmic composition after
  4. ;reading Douglas Hofstadter's excellent book "Godel, Esher, Bach" in which
  5. ;he remarks that in his opinion meaningful computer composition is many years away.
  6. ;For some reason I disagree with him although I would be hard put to construct
  7. ;a logical defence.
  8.  
  9. ;Harmony, strangely enough, proved the least of problems. The real problem is
  10. ;to devise algorithms which produce cogent phrases, rhythms and forms.
  11. ;Mathematical form does not imply nice music; the serialists at least taught
  12. ;us that much. Aleatoric methods are just about as dull. Somewhere between
  13. ;perfect abstract form and the totally stochastic must lie areas of life and
  14. ;meaning. If computer programmes can help human brains to find them then
  15. ;so much the better.
  16.  
  17. ;The whole field seems to me to be a grossly neglected area of research.
  18. ;It may be that the structures which give rise to the various emotive responses in
  19. ;music are quite simple. There is also the question of to what degree the
  20. ;listener imposes an emotional response on a piece of music. This propensity
  21. ;may be more powerful than we would like to believe. I remember playing the
  22. ;piano for a particular friend on several occasions and being mystified that
  23. ;his opinions contrasted sharply from one time to the next. I finally found
  24. ;that anything I played which included either ninth chords or syncopation was
  25. ;anathema and anything which did not include these things was deemed masterly!
  26. ;When I played a mixture of sections with and sections without he became
  27. ;irritable and wanted to stop for a drink.
  28.  
  29. Filter Off
  30. Screen 0,10
  31. ScreensBitMap 0,0
  32. ShowScreen 0
  33. Use BitMap 0
  34. Cls 0
  35. BitMapOutput 0
  36. Locate 2,5:Print "A simple programme to compose fugues."
  37. Locate 2,7:Print "Hold right mouse button to stop."
  38.  
  39. ;Periods
  40. Data.w 1712,1616,1524,1440,1356,1280,1208,1140,1076,1016,960,906
  41. Data.w 856,808,762,720,678,640,604,570,538,508,480,453
  42. Data.w 428,404,381,360,339,320,302,285,269,254,240,226
  43. Data.w 214,202,190,180,170,160,151,143,135,127
  44.  
  45. ;Data for "legitimate" harmonies for desired style.
  46. ;In this case very old-fashioned.
  47. ;Majors,minors,diminisheds,sevenths,sixths,minor sixths
  48. ;unisons,double notes etc. (whatever is desired)
  49. Data.w 652,422,522,642,542,412,4392,3062,5602,4502,4402
  50. Data.w 4272,5712,4512,3072,4282,4382,5722,3182
  51. Data.w 12,42,102,92,52,72
  52.  
  53. ;Data for permissible modulations.
  54. Data.w 0,4,2,5,4,3,2,1,3,0,0,0,5,3,0,4,5,0,7,3,0,1,5,0,102,3,0,2,5,0,109,4,0,2,3,4
  55. Data.w 100,3,2,1,4,0,3,4,3,0,4,5,7,1,0,0,0,0,8,2,1,4,0,0,105,3,0,1,3,0,107,1,1,0,0,0
  56.  
  57. Data.s theegg,cordpiano,piano,bubble,warmbells
  58.  
  59. ;Sound structures
  60. NEWTYPE.chrom
  61.   adr_sound.l
  62.   ss.w
  63.   period.w
  64. End NEWTYPE
  65.  
  66. NEWTYPE.sound
  67.   _data.l
  68.   _period.w
  69. End NEWTYPE
  70.  
  71. ;Set fugue length (number of shortest note lengths)
  72. fl.w=512:fl1.w=fl-1
  73.  
  74. ;Dimension arrays
  75. Dim motifs.w(100)
  76. Dim voices.w(fl,4)
  77. Dim inst.w(fl)
  78. Dim chrom_scale.chrom(84)
  79. Dim chrom_scale2.chrom(84)
  80. Dim maj_scale.w(12,84)
  81. Dim min_scale.w(12,84)
  82. Dim maj_tonics.w(12)
  83. Dim min_tonics.w(12)
  84. Dim fugue.w(fl,4)
  85. Dim fixed.w(fl,4)
  86. Dim fugue_ctype.w(fl)
  87. Dim modes.w(fl)
  88. Dim tempi.w(fl)
  89. Dim t.w(3),interval.w(4),s.w(4),interval2.w(4),legit_chord.w(31)
  90. Dim fix_pos.w(4)
  91. Dim maj_shifts.w(6,6),min_shifts.w(6,6)
  92. Dim lastmstart.w(4)
  93. Dim insts.s(5)
  94.  
  95.  
  96. s.w=0
  97.  
  98. ;Set length of fixed section motifs (opening)
  99. fix_length.w=32
  100. For i=0 To 3:fix_pos(i)=i*fix_length:Next i
  101.  
  102. ;Set out chromatic scale
  103. For i=0 To 45
  104.   Read chrom_scale(i)\period
  105.   chrom_scale2(i)\period=chrom_scale(i)\period
  106.   chrom_scale(i)\adr_sound=Addr Sound(0)
  107.   chrom_scale(i)\ss=0
  108.   chrom_scale2(i)\adr_sound=Addr Sound(2)
  109.   chrom_scale2(i)\ss=2
  110. Next
  111.  
  112. ;Read allowable chord types
  113. For i=0 To 24:Read legit_chord(i):Next i
  114.  
  115. ;Read the tune
  116. ;For i=0 To 39:Read motifs(i):Next i
  117.  
  118. ;Read permissible modulations
  119. For i=0 To 5:For j=0 To 5:Read maj_shifts(i,j):Next:Next
  120. For i=0 To 5:For j=0 To 5:Read min_shifts(i,j):Next:Next
  121.  
  122. ;Read instrument names
  123. For i=0 To 4
  124.   Read insts(i)
  125. Next
  126.  
  127. ;Read the rest of the chromatic scale
  128. ;It is necessary to split it between two instruments
  129. ;two octaves apart
  130.  
  131. For i=46 To 71
  132.   chrom_scale(i)\period=chrom_scale(i-24)\period
  133.   chrom_scale(i)\adr_sound=Addr Sound(1)
  134.   chrom_scale(i)\ss=1
  135.   chrom_scale2(i)\period=chrom_scale2(i-24)\period
  136.   chrom_scale2(i)\adr_sound=Addr Sound(3)
  137.   chrom_scale2(i)\ss=3
  138. Next
  139.  
  140. ;Set out diatonic major and minor scales
  141. For i=0 To 11:wi=0
  142.   For j=0 To 71
  143.     ij=((i+j) MOD 12)
  144.     If ij=0 OR ij=2 OR ij=4 OR ij=5 OR ij=7 OR ij=9 OR ij=11
  145.       maj_scale(i,wi)=j:wi+1
  146.     EndIf
  147. Next:Next
  148. For i=0 To 11:wi=0
  149.   For j=0 To 71
  150.     ij=((i+j) MOD 12)
  151.     If ij=0 OR ij=2 OR ij=3 OR ij=5 OR ij=7 OR ij=8 OR ij=11
  152.       min_scale(i,wi)=j:wi+1
  153.     EndIf
  154. Next:Next
  155.  
  156. ;Establish the positions of the tonic notes for each scale
  157. For i=0 To 11
  158.   j=-1
  159.   Repeat
  160.     j+1
  161.   Until maj_scale(i,j)+6=maj_scale(i,j+3) AND maj_scale(i,j)+2=maj_scale(i,j+1)
  162.   maj_tonics(i)=j+4
  163. Next
  164. For i=0 To 11
  165.   j=-1
  166.   Repeat
  167.     j+1
  168.   Until min_scale(i,j)+3=min_scale(i,j+1)
  169.   min_tonics(i)=j+2
  170. Next
  171.  
  172. While Joyb(1)=0
  173.  
  174. ;Clear instruments and load new ones
  175. Free Sound 0
  176. Free Sound 1
  177. Free Sound 2
  178. Free Sound 3
  179. Gosub getinst
  180.  
  181. ;Generate tune
  182. ;To write a routine to compose even a simple meaningful
  183. ;melody is VERY DIFFICULT. This only scratches the surface
  184. ;of what promises to be a very interesting investigation.
  185. motifs(0)=Rnd(7)
  186.  
  187. i=1:last_note.w=motifs(0)
  188. If Rnd(100)>50:tune_dirn.w=1:Else:tune_dirn=-1:EndIf
  189. density.w=50+Rnd(40):spaces.w=Rnd(4)+1
  190. If Rnd(100)>80:spaces.w=Rnd(4):Else:spaces=0:EndIf
  191. For i=1 To 39
  192.   If Rnd(100)<density
  193.     If Rnd(100)>70
  194.       tune_dirn=-tune_dirn
  195.     EndIf
  196.     motifs(i)=(last_note+tune_dirn*(Rnd(spaces)+1)+8) MOD 8
  197.     last_note=motifs(i)
  198.   Else
  199.     motifs(i)=999
  200.   EndIf
  201. Next
  202.  
  203. ;Clear fugue data to rests and set tempo
  204. main_temp.w=7+Rnd(10)
  205. For i=0 To fl1:For j=0 To 3:fugue(i,j)=999:Next:tempi(i)=main_temp:Next
  206. For i=0 To 15
  207.   tempi(496+i)=tempi(0)+2*i
  208. Next i
  209.  
  210. ;Set out modulations
  211. piece_mode.w=Int(Rnd(2))
  212. If Rnd(100)>50:piece_mode=0:Else:piece_mode=1:EndIf
  213. piece_key.w=100*piece_mode+Int(Rnd(12))
  214. modes(0)=0
  215. Repeat
  216.   For i=32 To 480 Step 32
  217.     If piece_mode.w=0
  218.       modes(i)=maj_shifts(modes(i-32),Int(Rnd(maj_shifts(modes(i-32),1))+2))
  219.     Else
  220.       modes(i)=min_shifts(modes(i-32),Int(Rnd(min_shifts(modes(i-32),1))+2))
  221.     EndIf
  222.   Next
  223. Until modes(480)=0
  224. For i=0 To 480 Step 32
  225.   If piece_mode=0
  226.     r.w=maj_shifts(modes(i),0)
  227.     If r>90:q.w=100 Else:q=0:EndIf
  228.     r=(((r MOD 100)+piece_key) MOD 12)+q
  229.   Else
  230.     r.w=min_shifts(modes(i),0)
  231.     If r>90:q.w=100 Else:q=0:EndIf
  232.     r=(((r MOD 100)+piece_key-100) MOD 12)+q
  233.   EndIf
  234.   For j=0 To 31:modes(i+j)=r:Next
  235. Next
  236.  
  237. ;Insert opening modulations
  238. If piece_mode=0
  239.   sub_dom=(piece_key+5) MOD 12
  240. Else
  241.   sub_dom=((piece_key-95) MOD 12)+100
  242. EndIf
  243. For i=0 To 31:modes(i)=piece_key:Next i
  244. For i=32 To 63:modes(i)=sub_dom:Next i
  245. For i=64 To 95:modes(i)=piece_key:Next i
  246. For i=96 To 127:modes(i)=sub_dom:Next i
  247.  
  248. ;Write fixed sections
  249. ;Could easily be adapted to write sequences and stretto
  250.  
  251. ;Opening
  252. For i=0 To 3
  253. If piece_mode=0
  254.   Select i
  255.     Case 0:spitch.w=maj_tonics(modes(i*32))+14
  256.     Case 1:spitch=maj_tonics(modes(i*32))+7
  257.     Case 2:spitch=maj_tonics(modes(i*32))+14
  258.     Case 3:spitch=maj_tonics(modes(i*32))+7
  259.   End Select
  260. Else
  261.   Select i
  262.     Case 0:spitch=min_tonics(modes(i*32)-100)+21
  263.     Case 1:spitch=min_tonics(modes(i*32)-100)+14
  264.     Case 2:spitch=min_tonics(modes(i*32)-100)+14
  265.     Case 3:spitch=min_tonics(modes(i*32)-100)+7
  266.   End Select
  267. EndIf
  268.   For j=0 To fix_length-1
  269.   ii.w=fix_length*i+j
  270.  
  271.   For k=i To 3
  272.     fixed(ii,k)=1
  273.   Next k
  274.   If i<3
  275.     For k=i To 3:fugue(ii,k)=999:Next k
  276.   EndIf
  277.   key=modes(ii):mm=motifs(j)
  278.     If mm=999
  279.       fugue(ii,i)=999
  280.     Else
  281.       If key>90
  282.         key-100
  283.         fugue(ii,i)=min_scale(key,spitch+mm)
  284.       Else
  285.         fugue(ii,i)=maj_scale(key,spitch+mm)
  286.       EndIf
  287.     EndIf
  288. Next:Next
  289.  
  290. ;Write final cadence
  291. For i=504 To 511
  292. For j=0 To 3
  293. fugue(i,j)=999:fixed(i,j)=1
  294. Next:Next
  295. key=modes(504)
  296. If key>=100:key-100:EndIf
  297. fugue(504,0)=maj_scale(key,maj_tonics(key))
  298. fugue(504,1)=maj_scale(key,maj_tonics(key)+9)
  299. fugue(504,2)=maj_scale(key,maj_tonics(key)+11)
  300. fugue(504,3)=maj_scale(key,maj_tonics(key)+14)
  301.  
  302. ;Main composition loop
  303. ;The algorithm is very simple.For each bar and voice a random section of tune
  304. ;is selected. An attempt is made to place it so that all resulting
  305. ;harmonies belong to the "legitimate" table. This is a lot easier
  306. ;than it seems because any chord TYPE (major, minor, augmented 9th or
  307. ;what have you as opposed to inversions or positions) is completely
  308. ;characterised by a partition of twelve. A chromatic scale is a cyclic
  309. ;group of order twelve.
  310.  
  311. ;If the section of melody cannot be fitted to produce "legitimate"
  312. ;harmonies then it is transposed tonally in whatever key predominates
  313. ;(the modulations are set out in advance). If it does not fit after
  314. ;trying all seven scale transpositions it is discarded and a new one
  315. ;selected.
  316. Locate 2,10:NPrint "NOW COMPOSING BAR        "
  317. For ii.w=0 To 508 Step 4:Locate 22,10:NPrint (ii/8)+1:For voice.w=0 To 3
  318. If Joyb(1)<>0:Pop For:Goto fin:EndIf
  319. If fixed(ii,voice)=1:Goto w1:EndIf
  320.   Repeat
  321.     If ii>=400 AND ii<500
  322.       mstart.w=Int(Rnd(5))*4:spitch.w=15+Int(Rnd(15)):s=-1
  323.     Else
  324.       If Rnd*100>10
  325.         mstart.w=lastmstart(voice):spitch.w=15+Int(Rnd(15)):s=-1
  326.       Else
  327.         mstart.w=Int(Rnd(10))*4:spitch.w=15+Int(Rnd(15)):s=-1
  328.       EndIf
  329.     EndIf
  330.     Repeat
  331.       s+1
  332.       k=-1
  333.         Repeat
  334.         k+1
  335.         key=modes(ii+k):mm=motifs(mstart+k)
  336.         If mm=999
  337.           fugue(ii+k,voice)=999
  338.         Else
  339.           If key>90
  340.             key-100
  341.             fugue(ii+k,voice)=min_scale(key,spitch+mm-s)
  342.           Else
  343.             fugue(ii+k,voice)=maj_scale(key,spitch+mm-s)
  344.           EndIf
  345.         EndIf
  346.         fi=ii+k:Gosub chord_type
  347.         flag=0:j=-1
  348.         Repeat
  349.           j+1
  350.           If ctype=legit_chord(j):flag=1:EndIf
  351.         Until j=24 OR flag=1
  352.       Until k=3 OR flag=0
  353.     Until s=6 OR flag=1
  354.   Until flag=1
  355.   lastmstart(voice)=mstart
  356. w1:Next:Next
  357.  
  358. ;Play fugue
  359.  
  360. Locate 2,12:Print "NOW PLAYING BAR        "
  361. For i=0 To fl1
  362.   fi=i:Gosub chord_type:fugue_ctype(i)=ctype
  363. Next i
  364. For i=0 To fl-8
  365.   If Joyb(1)<>0:Pop For:Goto fin:EndIf
  366.   Locate 22,12:Print Int(i/8+1)
  367.   If fugue(i,0)<999
  368.     Poke.w chrom_scale(fugue(i,0))\adr_sound+4,chrom_scale(fugue(i,0))\period
  369.    Sound chrom_scale(fugue(i,0))\ss,1
  370.   EndIf
  371.   If fugue(i,1)<999
  372.     Poke.w chrom_scale2(fugue(i,1))\adr_sound+4,chrom_scale2(fugue(i,1))\period
  373.     Sound chrom_scale2(fugue(i,1))\ss,2
  374.   EndIf
  375.   If fugue(i,2)<999
  376.     Poke.w chrom_scale(fugue(i,2))\adr_sound+4,chrom_scale(fugue(i,2))\period
  377.     Sound chrom_scale(fugue(i,2))\ss,4
  378.   EndIf
  379.   If fugue(i,3)<999
  380.     Poke.w chrom_scale2(fugue(i,3))\adr_sound+4,chrom_scale2(fugue(i,3))\period
  381.     Sound chrom_scale2(fugue(i,3))\ss,8
  382.   EndIf
  383.   VWait tempi(i)
  384. Next
  385.  
  386. VWait 200
  387. Wend
  388. fin:VWait 50
  389. End
  390.  
  391. ;Subroutine to analyse harmonies
  392. ;This is based on an article I wrote in the N.Z Mathematics
  393. ;Magazine many years ago about the possibility of using a
  394. ;simple theorem on groups to characterise chord types.
  395. chord_type:
  396.   For q=0 To 3:t(q)=fugue(fi,q):Next q
  397.   Sort t()
  398.   If t(0)=999:ctype=12:Return:EndIf
  399.   For m=1 To 3
  400.     If t(m)=999:t(m)=t(m-1):EndIf
  401.   Next
  402.   For q=0 To 3:t(q)=t(q) MOD 12:Next q
  403.   Sort t()
  404.   For ri=1 To 3
  405.     interval(ri-1)=t(ri)-t(ri-1)
  406.   Next
  407.   interval(3)=12-interval(0)-interval(1)-interval(2)
  408.   wi=0
  409.   For m=0 To 3
  410.     interval2(m)=0
  411.     If interval(m)>0:interval2(wi)=interval(m):wi+1:EndIf
  412.   Next
  413.   For m=0 To 3:interval(m)=interval2(m):Next
  414.   ctype=interval(0)+interval(1)*11+interval(2)*121+interval(3)*1331
  415. Return
  416.  
  417. getinst:
  418.   inst1.w=Rnd(5):inst2.w=Rnd(5)
  419.   LoadSound 0,insts(inst1)+"_low"
  420.   LoadSound 1,insts(inst1)+"_high"
  421.   LoadSound 2,insts(inst2)+"_low"
  422.   LoadSound 3,insts(inst2)+"_high"
  423. i7:VWait 100:Return
  424.